HPAVC/HPAVC CD-ROM.iso/pc/CON-03A.ZIP/COMMS.PAS

Pascal/Delphi Source File | 1995-04-17 | 3.6 KB | 210 lines

unit comms;

interface

var

comport,modemspeed : integer;
secret, auto_det : boolean;

procedure  sendln(stri : string);
procedure  sendch(cha : char);
function   getch                      : char;
procedure  init_comms;
function   carrier                    : boolean;
procedure  sc(cha : char);
procedure  send(stri : string);
function   num(numb : longint)        : string;
function   unnum(string_num : string) : integer;
function   wfk                        : char;
function   getstring                  : string;
procedure  clearscreen;
procedure  modem_cmd(stri : string);
procedure  xy(x,y : integer);

implementation

uses crt, ansi_drv;


function char_avail : boolean;
var
   status : byte;
begin
   asm
      mov  ah,03h
      mov  dx,comport
      int  14h
      mov  status, ah
   end;
   char_avail:=(status and 1) = 1;
end;

procedure sendch(cha : char);
var status : byte;
    tosend : byte;
begin
  status:=128;
  tosend:=ord(cha);
  repeat
    asm
      mov ah,01
      mov dx,comport
      mov al,tosend
      int 14h
      mov status,ah
    end
  until (status and 128) = 0;
end;


function getch : char;
var status,cha : byte;
begin
    status:=128;
    if char_avail then begin
      asm
        mov ah,02
        mov dx,comport
        int 14h
        mov cha,al
        mov status,ah
      end;
    end;
    if (status and 128) = 128 then getch:=chr(255) else getch:=chr(cha);
end;


procedure init_comms;
var speed : byte;
begin
{  writeln('Initialising communications port!');
  case modemspeed of
    19200 : speed:=8;
     9600 : speed:=7;
     4800 : speed:=6;
     2400 : speed:=5;
     1200 : speed:=4;
  end;
  asm
    mov ah,04
    mov al,00
    mov bx,00
    mov ch,03
    mov cl,speed
    mov dx,comport
    int 14h
  end;
  sound(1000);
  delay(50);
  sound(700);
  delay(50);
  nosound; }
end;

function carrier : boolean;
var status : byte;
begin
  asm
    mov   ah,03
    mov   dx,comport
    int   $14
    mov   status,al
  end;
  carrier := status and 32 = 32;
end;

procedure modem_cmd(stri : string);
var aa : integer;
begin
  if not carrier then begin
      sound(1500);
      delay(20);
      nosound;
 {     sendch(#13);
      for aa:=1 to length(stri) do sendch(stri[aa]);
      sendch(#13); }
  end;
end;


procedure sc(cha : char);
begin
  if carrier and not secret then sendch(cha);
  if secret and carrier then sendch('■');
  ansi_write(cha);
end;


procedure send(stri : string);
var aa : integer;
begin
  for aa:=1 to length(stri) do sc(stri[aa]);
end;


procedure sendln(stri : string);
var aa : integer;
begin
  for aa:=1 to length(stri) do sc(stri[aa]);
  sc(chr(13));
  sc(chr(10));
end;


function num(numb : longint) : string;
var s : string;
begin
  str(numb, s);
  num:=s;
end;


function unnum(string_num : string) : integer;
var num,foo : integer;
begin
    val(string_num,num,foo);
    unnum:=num;
end;


function wfk : char;
var ch : char;
begin
  ch:=#255;
  repeat
    if keypressed then ch:=readkey else
    if carrier then ch:=getch;
  until ch<>chr(255);
  sc(ch);
  wfk:=ch;
end;


function getstring : string;
var count : integer;
    ch : char;
begin
  count:=0;
  repeat
    ch:=wfk;
    if (ch<>#13) and (ch<>#8) then begin
      inc(count);
      getstring[count]:=ch;
    end else if ch=#8 then dec(count);
  until ch=#13;
  getstring[0]:=chr(count);
end;

procedure xy(x,y : integer);
begin
  send(#27+'['+chr(x+ord('0'))+';'+chr(y+ord('0'))+'F');
end;

procedure clearscreen;
begin
  send(#27+'[2J');
  clrscr;
end;

end. {unit ends}